﻿Imports System.Windows.Forms

Public Class CCloseRing
    Const LINE_NODE_NO_FIELD = 1    '边编号
    Const LINE_BEGIN_NODE_FIELD = 2 '边开始节点
    Const LINE_END_NODE_FIELD = 3   '边结束节点

    Const NODE_NO_FIELD = 1    '节点编号
    Const NODE_LONGTITUDE_FIELD = 2    '节点经度
    Const NODE_LAIITUDE_FIELD = 3 '节点纬度
    Const NODE_ALTITUDE_FIELD = 4   '节点高程

    Const RING_NO_FIELD = 1    '环编号
    Const RING_STRING_FIELD = 2    '环节点编号


    Enum CompareSymbol
        EQUAR = 1
        GreateAndEquar = 2
        GreateThan = 3
        LessThan = 4
        LessEquar = 5

    End Enum


    Private line() As TypeLine          '边表

    Private ringLines() As TypeLine          '可以组成环的边

    Private node() As TypeNode          '节点表
    Private rings() As IClassTypeRing  '环数组
    Private ringArray As List(Of IClassTypeRing)  '环表





    Private loger As IClassLog = New IClassLog '日子记录员
    Private searchNodesStack() As TypeNode  '进行搜索的点的堆栈
    Private searchNodesStackCurrent As Integer  '进行搜索的点的堆栈当前节点
    Private backToNodesStack As Integer  '退回到搜索的节点
    Private searchNodesStack1 As Stack(Of TypeNode) = New Stack(Of TypeNode) '收索点数据列表
    Private searchLineStack As Stack(Of TypeLine) = New Stack(Of TypeLine) '搜索边数据列表

    Private lastRingEndNode As TypeNode

    ''' <summary>
    ''' 需要计算的节点属性
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property nodes() As TypeNode()
        Get
            Return node
        End Get
        Set(ByVal value As TypeNode())
            Me.node = value
        End Set
    End Property
    ''' <summary>
    ''' 需要计算的边的属性
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property lines() As TypeLine()
        Get
            Return line
        End Get
        Set(ByVal value As TypeLine())
            line = value
        End Set
    End Property


    Property searchedComplete As Boolean = False




    ''' <summary>
    ''' 结算结果
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property resultRings() As IClassTypeRing()
        Get
            Return rings
        End Get
        Set(ByVal value As IClassTypeRing())
            rings = value
        End Set
    End Property




    Public Function getNodes() As TypeNode()
        Return node
    End Function
    Public Function getLines() As TypeLine()
        Return line
    End Function
    ''' <summary>
    ''' 获取节点列表
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getNodesList() As List(Of TypeNode)

        Dim nodeList = New List(Of TypeNode)

        For Each tmpNode As TypeNode In getNodes()
            nodeList.Add(tmpNode)
        Next
        Return nodeList
    End Function
    ''' <summary>
    ''' 获取边节点
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getLinesList() As List(Of TypeLine)

        Dim lineList = New List(Of TypeLine)

        For Each tmpLine As TypeLine In getLines()
            lineList.Add(tmpLine)
        Next
        Return lineList
    End Function

    Private lineCounter As Integer = 0  '线路的编号器

    Protected Shared RingThreadCnt As CRingThreadCnt = New CRingThreadCnt()


    Class CRingThreadCnt
        Protected Friend RingThreadCnt As Integer = 0
        Protected Sub add()
            RingThreadCnt += 1
        End Sub
        Protected Sub subs()
            RingThreadCnt -= 1
        End Sub

    End Class
    ''' <summary>
    ''' 获取环列表
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getResultRingList() As List(Of IClassTypeRing)

        If Not ringArray Is Nothing Then
            ringArray.Clear()
        End If

        ringArray = New List(Of IClassTypeRing)

        For Each tmpRing As IClassTypeRing In rings
            ringArray.Add(tmpRing)
        Next



        Return ringArray
    End Function

    Public Function getResultRing() As IClassTypeRing()
        getResultRing = rings
    End Function


    Public Sub builderLines(ByVal lineArray)
        ' 建立节点列表
        ReDim line(UBound(lineArray))

        Dim lineList As List(Of TypeLine) = New List(Of TypeLine)


        Dim tmpNode As TypeNode
        Dim tmpPointNo As String
        Dim tmpline As TypeLine

        Dim nCNt As Integer = 0
        Dim i As Integer = 0



        For i = LBound(lineArray) To UBound(lineArray)
            '    For Each tmpArray As Array In lineArray

            'Next

            '建立边数组
            tmpline = createNewLine()
            tmpline.setNull(False)
            tmpline.setDelete(False)
            'tmpline.sLineNo = tmpArray(LINE_NODE_NO_FIELD) '编号

            tmpline.sLineNo = lineArray(i, LINE_NODE_NO_FIELD) '编号

            If tmpline.sLineNo Is Nothing Or tmpline.sLineNo = "" Then
                '不是合适的边数据
                Continue For
            End If


            '加入边
            line(i) = tmpline

            '根据边，建立节点列表 开始节点 
            tmpPointNo = lineArray(i, LINE_BEGIN_NODE_FIELD)
            tmpNode = findNode(tmpPointNo)
            If tmpNode Is Nothing Then
                tmpNode = createNewNode()
                tmpNode.sNodeNo = tmpPointNo
                tmpNode.iUseCNT = 0
                tmpNode.SetNull(False)
                tmpNode.SetDelete(False)
                insertNode(tmpNode, node)
            End If
            '增加一次引用
            tmpNode.iUseCNT = tmpNode.iUseCNT + 1
            tmpline.startNode = tmpNode '开始节点

            '根据边，建立节点列表 结束节点 
            tmpPointNo = lineArray(i, LINE_END_NODE_FIELD)
            tmpNode = findNode(tmpPointNo)
            If tmpNode Is Nothing Then
                tmpNode = createNewNode()
                tmpNode.sNodeNo = tmpPointNo
                tmpNode.iUseCNT = 0
                tmpNode.SetNull(False)
                tmpNode.SetDelete(False)
                insertNode(tmpNode, node)
            End If
            '增加一次引用
            tmpNode.iUseCNT = tmpNode.iUseCNT + 1
            tmpline.endNode = tmpNode  '结束节点

            nCNt = nCNt + 1


            lineList.Add(tmpline)
        Next i

        lineList.Sort()
        line = lineList.ToArray

        '缩小边数据
        '  ReDim Preserve line(nCNt - 1)

    End Sub

    Public Sub builderNodes(ByVal pointArray)
        ' 建立节点列表
        ReDim node(UBound(pointArray))
        Dim tmpNode As TypeNode
        Dim tmpPointNo As String

        Dim nodelist As List(Of TypeNode) = New List(Of TypeNode)

        Dim nCNt As Integer = 0
        Dim i As Integer = 0
        For i = 0 To UBound(pointArray)
            '根据边，建立节点列表 开始节点 
            tmpPointNo = pointArray(i, NODE_NO_FIELD)
            If tmpPointNo = "" Then
                Continue For
            End If
            tmpNode = findNode(tmpPointNo)
            If tmpNode Is Nothing Then
                tmpNode = createNewNode()
                tmpNode.sNodeNo = tmpPointNo
                tmpNode.iUseCNT = 0
                tmpNode.SetNull(False)
                tmpNode.SetDelete(False)
                tmpNode.longitude = Math.Round(Double.Parse(pointArray(i, NODE_LONGTITUDE_FIELD)), 6) '经度
                tmpNode.latitude = Math.Round(Double.Parse(pointArray(i, NODE_LAIITUDE_FIELD)), 6) '纬度
                tmpNode.altitude = Math.Round(Double.Parse(pointArray(i, NODE_ALTITUDE_FIELD)), 6) '高程
                node(nCNt) = tmpNode
                nCNt += 1

                nodelist.Add(tmpNode)

            Else
                Continue For
            End If
        Next

        nodelist.Sort()
        node = nodelist.ToArray()
        '缩小节点数据
        'ReDim Preserve node(nCNt - 1)



    End Sub


    Private Sub initData(ByVal lineArray, ByVal pointArray)
        '初始化数据
        ReDim line(UBound(lineArray))
        ReDim node(UBound(lineArray) * 2)

        Dim tmpLine As TypeLine
        Dim tmpNode As TypeNode
        Dim tmpPointNo As String
        Dim tmpPointPostion As Integer

        For i = LBound(node) To UBound(node)
            node(i) = createNewNode()
        Next

        For i = LBound(line) To UBound(line)
            line(i) = createNewLine()
        Next

        For i = LBound(lineArray) To UBound(lineArray)
            '建立边数组
            tmpLine = createNewLine()
            tmpLine.setNull(False)
            tmpLine.setDelete(False)
            tmpLine.sLineNo = lineArray(i, LINE_NODE_NO_FIELD) '编号

            '加入边
            line(i) = tmpLine

            '根据边，建立节点列表 开始节点 
            tmpNode = createNewNode()
            tmpPointNo = lineArray(i, LINE_BEGIN_NODE_FIELD)
            tmpNode = findNode(tmpPointNo)
            If tmpNode.sNodeNo = "-1" Then
                '没有找到节点
                tmpNode.sNodeNo = tmpPointNo
                tmpNode.iUseCNT = 0
                tmpNode.SetNull(False)
                tmpNode.SetDelete(False)
                tmpPointPostion = findPoint(tmpNode.sNodeNo, pointArray)
                If tmpPointPostion >= 0 Then
                    tmpNode.longitude = pointArray(tmpPointPostion, NODE_LONGTITUDE_FIELD) '经度
                    tmpNode.latitude = pointArray(tmpPointPostion, NODE_LAIITUDE_FIELD) '纬度
                    tmpNode.altitude = pointArray(tmpPointPostion, NODE_ALTITUDE_FIELD) '高程
                End If
                '将节点插入表中
                insertNode(tmpNode, node)
            End If
            '增加一次引用
            tmpNode.iUseCNT = tmpNode.iUseCNT + 1

            tmpLine.startNode = tmpNode '开始节点


            '根据边，建立节点列表 结束节点 
            tmpNode = createNewNode()
            tmpPointNo = lineArray(i, LINE_END_NODE_FIELD)
            tmpNode = findNode(tmpPointNo)
            If tmpNode.sNodeNo = "-1" Then
                '没有找到节点
                tmpNode.sNodeNo = tmpPointNo
                tmpNode.iUseCNT = 0
                tmpNode.SetNull(False)
                tmpNode.SetDelete(False)
                tmpPointPostion = findPoint(tmpNode.sNodeNo, pointArray)
                If tmpPointPostion >= 0 Then
                    tmpNode.longitude = pointArray(tmpPointPostion, NODE_LONGTITUDE_FIELD) '经度
                    tmpNode.latitude = pointArray(tmpPointPostion, NODE_LAIITUDE_FIELD) '纬度
                    tmpNode.altitude = pointArray(tmpPointPostion, NODE_ALTITUDE_FIELD) '高程
                End If
                '将节点插入表中
                insertNode(tmpNode, node)
            End If
            '增加一次引用
            tmpNode.iUseCNT = tmpNode.iUseCNT + 1
            tmpLine.endNode = tmpNode  '结束节点
        Next i

    End Sub
    Private Function findNode(ByVal pointNO As String, ByRef nodeList() As TypeNode, Optional ByVal startPoistion As Integer = -1) As TypeNode
        '根据节点编号，查找节点信息
        Dim node As TypeNode
        findNode = createNewNode()
        findNode.sNodeNo = "-1"
        If nodeList Is Nothing Then
            Return Nothing
        End If
        For i = Math.Max(LBound(nodeList), startPoistion) To UBound(nodeList)
            node = nodeList(i)
            If node Is Nothing Then
                Continue For
            End If

            If node.sNodeNo = pointNO Then
                findNode = Nothing
                findNode = node
                Exit For
            End If
        Next
    End Function

    Private Function findNode(ByVal nodeNo As String) As TypeNode
        '搜索节点
        If node Is Nothing Then
            Return Nothing
        End If


        For Each tmpNode As TypeNode In node
            If tmpNode Is Nothing Then
                Continue For
            End If

            If tmpNode.sNodeNo = nodeNo Then
                findNode = tmpNode
                Exit Function
            End If
        Next

        findNode = Nothing

    End Function
    ''' <summary>
    ''' 根据起点后终点，查找对应的边
    ''' </summary>
    ''' <param name="tStartNode">开始节点</param>
    ''' <param name="tEndNode">结束节点 </param>
    ''' <param name="bDirect">是否有方向</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function findLine(ByRef tStartNode As TypeNode, ByVal tEndNode As TypeNode, Optional ByVal bDirect As Boolean = False) As TypeLine
        Dim tline As TypeLine
        Dim linesCnt As Integer
        linesCnt = 0
        For Each tline In line
            If Not tline.isNull Then
                '非空线
                If tline.startNode.sNodeNo = tStartNode.sNodeNo Then
                    '开始节点相同
                    If tline.endNode.Equals(tEndNode) Then
                        '直到了对应的线
                        findLine = tline
                        Return tline
                    End If
                End If
                If bDirect = False Then
                    '如果不是有方向的查找，结束节点和该节点一致的也需要查找出来
                    If tline.endNode.Equals(tStartNode) Then
                        If tline.startNode.Equals(tEndNode) Then
                            tline.reverseLine()
                            findLine = tline
                            Return tline
                        End If
                        '结束节点是,则翻转该线，便于排序
                    End If
                End If
            End If
        Next
        Return Nothing
    End Function



    ''' <summary>
    ''' 根据节点，查找该节点所有的边
    ''' </summary>
    ''' <param name="tNode">起点</param>
    ''' <param name="bDirect">是否有方向</param>
    ''' <returns>符合条件的线</returns>
    ''' <remarks></remarks>
    Private Function findLines(ByRef tNode As TypeNode, Optional ByVal bDirect As Boolean = False) As TypeLine()
        '根据节点，查找该节点所有的边
        Dim tline As TypeLine
        Dim linesCnt As Integer
        Dim tmpFindLines() As TypeLine

        ReDim tmpFindLines(0)
        linesCnt = 0
        For Each tline In line
            If Not tline.isNull Then
                '非空线
                If tline.startNode.sNodeNo = tNode.sNodeNo Then
                    '开始节点是
                    ReDim Preserve tmpFindLines(linesCnt)
                    tmpFindLines(linesCnt) = tline
                    linesCnt = linesCnt + 1
                End If
                If bDirect = False Then
                    '如果不是有方向的查找，结束节点和该节点一致的也需要查找出来
                    If tline.endNode.sNodeNo = tNode.sNodeNo Then
                        '结束节点是,则翻转该线，便于排序
                        tline.reverseLine()
                        ReDim Preserve tmpFindLines(linesCnt)
                        tmpFindLines(linesCnt) = tline
                        linesCnt = linesCnt + 1
                    End If
                End If
            End If
        Next
        findLines = tmpFindLines
    End Function


    Private Sub insertNode(ByRef pNode As TypeNode, ByRef nodelist() As TypeNode)
        '将节点插入节点数据列表
        Dim tmpNode As TypeNode
        Dim i As Integer

        If nodelist Is Nothing Then
            ReDim nodelist(0)
            nodelist(0) = pNode
            Exit Sub
        End If


        For i = LBound(nodelist) To UBound(nodelist)
            tmpNode = nodelist(i)
            If tmpNode Is Nothing Then
                nodelist(i) = pNode
                Exit Sub
            End If
            If tmpNode.isNull Then
                nodelist(i) = pNode
                Exit Sub
            End If
        Next


        i = nodelist.GetLength(0)
        ReDim Preserve nodelist(nodelist.GetLength(0) + 1)
        nodelist(i) = pNode

    End Sub

    Private Function findPoint(ByVal pointNO As String, ByVal pointArray(,) As Object, Optional ByVal startPoistion As Integer = -1) As Integer
        '根据节点编号，查找节点信息
        findPoint = -1
        For i = Math.Max(LBound(pointArray), startPoistion) To UBound(pointArray)
            If pointArray(i, NODE_NO_FIELD) = pointNO Then
                findPoint = i
                Exit For
            End If
        Next
    End Function

    Public Sub findCloseRings(Optional ByRef init As Boolean = True)

        Me.searchedComplete = False
        ''初始化参数
        If init = True Then
            For Each tmpNode As TypeNode In nodes
                If Not tmpNode Is Nothing Then
                    tmpNode.searched = False
                End If
            Next
        End If

        '查找环数据
        clearData()
        Array.Sort(node, New MyCampare1)
        '3:删除单节点
        deleteSingleNode()
        '2:数据规整化
        clearData()
        '构建环

        ' ''构建单独环，构建复合边
        '添加了，不能很好的搜索出边
        'buildCompLine()
        'clearData()


        'ReDim rings(0)
        ' ''构建自有环
        'buildSelfRing()
        'clearNoMiniRings() '清理最小环
        'If ClassConsManager.SEARCH_THREAD_ABLE = True Then

        '    While RingThreadCnt.RingThreadCnt > 0
        '        Threading.Thread.Sleep(500)
        '    End While

        'End If

        ''3:删除单节点
        'deleteSingleNode()
        ''2:数据规整化
        'clearData()
        ''构建环

        loger.log("开始建环：", ClassConsManager.LOG_LEVEL_INFO)

        '进行循环，直到没有遍历的节点。
        Array.Sort(node, New MyCampare1)

        For Each tmpNode As TypeNode In node
            If Not tmpNode.isSearched Then
                '没有搜索过，进行搜索
                loger.log("起点环：" & tmpNode.sNodeNo, ClassConsManager.LOG_LEVEL_INFO)
                searchNodesStackCurrent = 0
                lastRingEndNode = Nothing
                buildRings(tmpNode, lastRingEndNode)
            End If
        Next

        '清理非最小环
        clearNoMiniRings()


        While RingThreadCnt.RingThreadCnt > 0
            Threading.Thread.Sleep(500)
        End While

        Array.Sort(rings)
        ringArray = New List(Of IClassTypeRing)
        '重新进行环编号
        Dim ringNum As Integer = 0
        For Each tmpRing As IClassTypeRing In rings
            If Not tmpRing Is Nothing Then
                If tmpRing.isMinRing Then
                    ringNum = 1 + ringNum
                    tmpRing.RingNo = ringNum
                    ringArray.Add(tmpRing)
                End If
            End If
        Next


        '获取最小环数据
        rings = ringArray.ToArray()


        '     ringArray.Sort()


        'ReDim rings(ringArray.Count - 1)
        'ringNum = 0
        'For Each tmpRing As IClassTypeRing In ringArray
        '    tmpRing.RingNo = ringNum + 1
        '    rings(ringNum) = tmpRing
        '    ringNum = ringNum + 1
        'Next



        '对非搜索过的边，进行搜索
        'For Each tmpLine In line
        '    If tmpLine.isSearched Then
        '        Continue For
        '    End If
        '    buildRingsByLine(tmpLine, lastRingEndNode)
        Me.searchedComplete = True






    End Sub

    Public Sub findCloseRings(ByRef pNodes() As TypeNode, ByRef pLine() As TypeLine)
        '查找环数据
        Me.node = pNodes
        Me.line = pLine
        findCloseRings()
    End Sub
    Public Sub findCloseRings(ByRef ringArray(,) As String, ByVal lineArray(,) As String, ByVal pointArray(,) As String)
        '寻找闭合环
        '参数 lineArray 边定义数据组（，1 to 10）,1 编号，2 开始点，3 结束点
        '参数 pointArray 点坐标定义数组（，1 to 10） 1 编号、2 经度、 3 纬度、 4高程 
        '参数 ringArray 闭合环定义数组（，1 to 10）  1 标号、2 环字符串、 3 数组（点编号） 
        '1:初始化数据
        '2:数据规整化
        '3:删除单节点
        '4:从节点边数最多的节点开始，进行组环
        '4.1:如果碰到多边点，根据坐标，选择最小环
        '5:判断是否重复环，是，丢弃，否，列入环表。
        '6：对环表进行清理，规格化
        '7：生成结果数据

        '  On Error Resume Next


        builderNodes(pointArray)
        builderLines(lineArray)


        '搜索环
        findCloseRings()


        '规格化结果环
        Dim i As Integer = 0
        ReDim ringArray(rings.GetLength(0), 10)
        i = 0
        For Each tmpRing As IClassTypeRing In rings
            If tmpRing Is Nothing Then
                Continue For
            End If
            If tmpRing.isMinRing Then

                '  Debug.Print("找到的环：" & tmpRing.getRingString)
                loger.log("找到的环：" & tmpRing.getRingString & "," & tmpRing.isMinRing, ClassConsManager.LOG_LEVEL_INFO)

                ringArray(i, RING_NO_FIELD) = tmpRing.GetRingNo   '环编号
                ringArray(i, RING_STRING_FIELD) = tmpRing.getRingString '环节点表
                i = i + 1
            End If
        Next


    End Sub
    Private Sub clearNoMiniRings()
        '清理出最小环的表，如果一个环和另一个环有交集。如果不是包含关系，两个环都不是最小环。
        '如果包含关系()，包含小环的环非最小环

        loger.log("清理最小环：", ClassConsManager.LOG_LEVEL_INFO)
        Dim i As Integer = 0
        For Each tmpRing As IClassTypeRing In rings
            If tmpRing Is Nothing Then
                Continue For
            End If
            If tmpRing.isMinRing Then
                For Each tmpRing1 As IClassTypeRing In rings
                    If tmpRing1 Is Nothing Then
                        Continue For
                    End If
                    If tmpRing1.GetRingNo = tmpRing.GetRingNo Then
                        '同一个环，不进行判断
                    Else
                        If tmpRing.isContain(tmpRing, tmpRing1) = 0 Then
                            '不是相互包含的环，不进行任何处理
                        Else
                            If tmpRing.isContain(tmpRing, tmpRing1) > 0 Then
                                ' If tmpRing.isInterSect(tmpRing, tmpRing1) = True Then
                                '判断这是否有包含关系，如果有，进行标记,不需要在和其余的环比较，直接下一个环
                                tmpRing.setMinRing(False)
                                loger.log("非最小环，丢弃：" & tmpRing.getRingString & "," & tmpRing1.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                            ElseIf tmpRing.isContain(tmpRing, tmpRing1) < 0 Then
                                tmpRing1.setMinRing(False)
                                loger.log("非最小环，丢弃：" & tmpRing.getRingString & "," & tmpRing1.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                            End If
                        End If
                    End If
                Next
            End If
            i = i + 1
        Next
    End Sub

    Private Sub clearData()
        '数据清理，规格化,将标记为删除的数据删除，重新规划列表大小
        Dim tmpLine As TypeLine
        Dim tmpNode As TypeNode
        Dim i As Integer

        Dim tmplineArray As List(Of TypeLine) = New List(Of TypeLine)
        '将删除节点剔除
        For Each tmpLine In line
            If tmpLine Is Nothing Then
            ElseIf tmpLine.isNull Or tmpLine.isDelete Then
            Else
                tmplineArray.Add(tmpLine)
            End If
        Next

        ' tmplineArray.Sort()
        line = tmplineArray.ToArray


        ''恢复回数组
        'ReDim line(tmplineArray.Count - 1)
        'i = 0
        'For Each tmpLine In tmplineArray
        '    line(i) = tmpLine
        '    i = i + 1
        'Next

        Dim tmpPointArray As List(Of TypeNode) = New List(Of TypeNode)
        '将删除节点剔除
        For Each tmpNode In node
            If tmpNode Is Nothing Then
            ElseIf tmpNode.isNull Or tmpNode.isDelete Then
            Else
                tmpPointArray.Add(tmpNode)
            End If
        Next
        ' tmpPointArray.Sort()
        node = tmpPointArray.ToArray



        '恢复回数组
        'ReDim node(tmpPointArray.Count - 1)
        'i = 0
        'For Each tmpNode In tmpPointArray
        '    node(i) = tmpNode
        '    i = i + 1
        'Next

    End Sub


    Private Function isDulRing() As Boolean
        '判断是否是重复的环，如果是，返回true，否返回false。判断依据，环内的节点完全一致，但是不包括顺序一致

    End Function


    Private Sub deleteSingleNode()
        '删除单线节点
        '找使用次数是一次的节点

        Dim tmpNode As TypeNode

        Dim nodeStatck As Stack(Of TypeNode) = New Stack(Of TypeNode) '需要删除的列表

        For Each tmpNode In node
            If tmpNode.getUseCNT <= 1 And tmpNode.isNull = False Then
                nodeStatck.Push(tmpNode)
            End If
        Next

        While nodeStatck.Count > 0
            Dim sNode As TypeNode = nodeStatck.Pop

            sNode.SetDelete(True)
            For Each tmpLine In line
                If (tmpLine.startNode.sNodeNo = sNode.sNodeNo Or tmpLine.endNode.sNodeNo = sNode.sNodeNo) And tmpLine.isDelete = False Then
                    '如果开始节点是需要删除的节点或者结束节点是需要删除的节点
                    '1、删除这条线，2、将开始节点或者结束节点的使用次数-1
                    tmpLine.setDelete(True)
                    If tmpLine.startNode.getUseCNT = 2 Then
                        nodeStatck.Push(tmpLine.startNode)
                    End If
                    tmpLine.startNode.setUseCNT(tmpLine.startNode.getUseCNT - 1)
                    If tmpLine.endNode.getUseCNT = 2 Then
                        nodeStatck.Push(tmpLine.endNode)
                    End If
                    tmpLine.endNode.setUseCNT(tmpLine.endNode.getUseCNT - 1)
                    Exit For
                End If
            Next
        End While




    End Sub
    Private Sub deletelineByNode(ByRef sNode As TypeNode, ByRef nodeStatck As Stack(Of TypeNode))
        '删除节点对应的线

        Dim tmpNode As TypeNode
        For Each tmpLine In line
            If (tmpLine.startNode.sNodeNo = sNode.sNodeNo Or tmpLine.endNode.sNodeNo = sNode.sNodeNo) And tmpLine.isDelete = False Then
                '如果开始节点是需要删除的节点或者结束节点是需要删除的节点
                '1、删除这条线，2、将开始节点或者结束节点的使用次数-1
                tmpLine.setDelete(True)
                If tmpLine.startNode.getUseCNT = 2 Then
                    nodeStatck.Push(tmpLine.startNode)
                End If
                tmpLine.startNode.setUseCNT(tmpLine.startNode.getUseCNT - 1)

                If tmpLine.endNode.getUseCNT = 2 Then
                    nodeStatck.Push(tmpLine.endNode)
                End If
                tmpLine.endNode.setUseCNT(tmpLine.endNode.getUseCNT - 1)


                '应该只使用了一次，这里可以退出，为了以后复用，先不退出
                'Exit For
            End If
        Next

    End Sub


    Private Function findDeepNode(Optional ByVal deep = 1000, Optional ByVal findType = 1) As TypeNode
        '查找节点中，使用维度为最接近给定值的节点
        Dim nodeNo As String
        Dim cMaxUseCNt, cMinUseCNT As Integer

        cMaxUseCNt = 0
        For Each tmpNode In node

            If tmpNode.iUseCNT >= deep And Not tmpNode.isNull And CompareSymbol.GreateThan = findType Then
                '大于选定维度
                findDeepNode = tmpNode
                Exit Function
            End If

            If cMaxUseCNt < tmpNode.getUseCNT Then
                findDeepNode = tmpNode
                cMaxUseCNt = tmpNode.getUseCNT
            End If

        Next

        findDeepNode = Nothing
    End Function

    Private Function findMaxDeepNode() As TypeNode
        '从列表中，查找节点中，使用维度为最接近给定值的节点
        Dim cMaxUseCNt As Integer
        Dim tmpNode As TypeNode
        cMaxUseCNt = 0
        findMaxDeepNode = node(0)

        For Each tmpNode In node
            If cMaxUseCNt <= tmpNode.getUseCNT And tmpNode.isDelete = False Then
                findMaxDeepNode = tmpNode
                cMaxUseCNt = tmpNode.getUseCNT
            End If
        Next

    End Function


    Private Sub buildRing(ByRef nextNode As TypeNode)
        '建立环表
        '    Debug.Print("print Ring")
        '    Debug.Print(nextNode.sNodeNo & "_" & nextNode.sNodeName)
        Dim nodeArrayList As ArrayList = New ArrayList()
        Dim i = 0
        Dim nodeCount As Integer
        Dim nodelist() As TypeNode
        nodeCount = 0
        ReDim nodelist(nodeCount)

        '检查有没有环
        For i = searchNodesStackCurrent To 0 Step -1
            '建立节点列表
            ReDim Preserve nodelist(nodeCount)
            nodelist(nodeCount) = searchNodesStack(i)
            nodeCount = nodeCount + 1

            '    Debug.Print(searchNodesStack(i).sNodeNo & "_" & searchNodesStack(i).sNodeName)
            If searchNodesStack(i).sNodeNo = nextNode.sNodeNo Then
                Exit For
            End If
        Next

        '根据节点，找到对应的边，根据边，获取对应的内部节点

        For i = 0 To nodelist.Length - 2
            Dim tmpNode1 As TypeNode = nodelist(i)
            Dim tmpNode2 As TypeNode = nodelist(i + 1)
            Dim tmpLine As TypeLine = findLine(tmpNode1, tmpNode2, False)
            nodeArrayList.Add(tmpNode1)

            If tmpLine.getLineType = ClassConsManager.LineTypeEnum.SIMPLE_LINE Then
                '是简单边
            ElseIf tmpLine.getLineType = ClassConsManager.LineTypeEnum.COMBIN_LINE Then
                '复合边
                For Each tn As TypeNode In tmpLine.getInnerNodes
                    '加入对应的符合边内节点
                    nodeArrayList.Add(tn)
                Next
            Else
                '环边，先不处理
                Dim aaa = 1
            End If
        Next

        nodeArrayList.Add(nodelist.GetValue(nodelist.Length - 1))




        '重新做节点数组
        ReDim nodelist(nodeArrayList.Count - 1)
        i = 0
        For Each tmpNode As TypeNode In nodeArrayList
            nodelist(i) = tmpNode
            i = i + 1
        Next


        Dim tmpRing As IClassTypeRing
        tmpRing = New IClassTypeRing(nodelist)


        '不是相同环，加入环表
        insertRing(tmpRing)

        nodelist = Nothing
        tmpRing = Nothing
    End Sub

    Private Sub buildRingsByLine(ByRef tmpLine As TypeLine, ByRef returNode As TypeNode)
        '根据给定节点，查找这个节点所有可能组成的环，递归调用
        Dim currentNode, nextNode, preNode, searchNode As TypeNode

        Dim hasRing As Boolean


        searchNode = tmpLine.startNode

        '标记为已经搜索
        searchNode.SetSearched(True)

        'Console.Out.Write(searchNode.sNodeNo)

        '获取当前最大节点Node
        If searchNode.isNull Then
            currentNode = findMaxDeepNode()
            searchNodesStackCurrent = 0
        Else
            currentNode = searchNode
        End If
        ReDim Preserve searchNodesStack(searchNodesStackCurrent)
        searchNodesStack(searchNodesStackCurrent) = currentNode

        searchNodesStack1.Push(currentNode)


        If searchNodesStackCurrent >= 1 Then
            '上一个节点
            preNode = searchNodesStack(searchNodesStackCurrent - 1)
        Else
            preNode = createNewNode()
        End If


        Dim lines() As TypeLine

        lines = findLines(currentNode)


        '对这些边进行优先排序,数据结构为（i，0） 线条的顺序，（i，1） 是否已经使用，收索优先顺序
        Dim lineSort(0, 2)
        Dim i As Integer = 0
        For i = 0 To lines.GetLength(0) - 1
            tmpLine = lines(i)
            lineSort(i, 0) = tmpLine
            lineSort(i, 1) = 0
            lineSort(i, 2) = 0
        Next


        For k = 0 To lineSort.GetLength(0) - 1

            lastRingEndNode = Nothing
            'If lineSort(k, 1) = 1 Then
            '    '该边已经搜索过，不在参与循环
            '    Continue For
            'End If

            tmpLine = lineSort(k, 0)
            lineSort(k, 1) = 1

            If tmpLine Is Nothing Then
                '如果存在不适合的数据，下一个数据
                Continue For
            End If


            '获取线路中的节点，如果
            If tmpLine.startNode.sNodeNo = currentNode.sNodeNo Then
                nextNode = tmpLine.endNode
            Else
                nextNode = tmpLine.startNode
            End If

            If nextNode.sNodeNo = preNode.sNodeNo Then
                '是上一条线路的回线，继续下一条线路
            Else
                '不是上一条线路的回线
                '不是回路，检查是否有环
                hasRing = False
                For i = searchNodesStackCurrent - 1 To 0 Step -1
                    If searchNodesStack(i).sNodeNo = nextNode.sNodeNo Then
                        '有环，建立环
                        hasRing = True
                        backToNodesStack = i
                        lastRingEndNode = currentNode
                        '退出循环
                        Exit For
                    End If
                Next
                If hasRing Then
                    '有环，建立环
                    buildRing(nextNode)
                    Exit For
                Else
                    '没有环，继续搜索下面的节点
                    searchNodesStackCurrent = searchNodesStackCurrent + 1
                    buildRings(nextNode, lastRingEndNode)
                End If
            End If




            If Not lastRingEndNode Is Nothing Then

                If backToNodesStack < searchNodesStackCurrent Then
                    '进行退栈，直到环上
                    Exit For
                End If


                '表示找到一个子环了，标记返回线为已搜索
                For kk = k + 1 To lineSort.GetLength(0) - 1
                    Dim tline As TypeLine = lineSort(kk, 0)
                    If tline.startNode.sNodeNo = lastRingEndNode.sNodeNo Or tline.endNode.sNodeNo = lastRingEndNode.sNodeNo Then
                        '返回线，
                        lineSort(kk, 1) = 1
                        Exit For
                    End If
                Next
            End If

            '如果节点队伍大于给定的最大搜索节点，不在该线上继续搜索下去
            If searchNodesStackCurrent > ClassConsManager.MAX_SEARCH_NODE_CNT Then
                Exit For
            End If

        Next
        '当前节点退栈
        searchNodesStackCurrent = searchNodesStackCurrent - 1
        searchNodesStack1.Pop()

        For i = 0 To lines.GetLength(0) - 1
            lineSort(i, 0) = Nothing
            lineSort(i, 1) = 0
            lineSort(i, 2) = 0
        Next


    End Sub


    Private Sub buildRings(ByRef searchNode As TypeNode, ByRef returNode As TypeNode)
        '根据给定节点，查找这个节点所有可能组成的环，递归调用
        Dim currentNode, nextNode, preNode As TypeNode
        Dim tmpline As TypeLine
        Dim hasRing As Boolean

        '标记为已经搜索
        searchNode.SetSearched(True)

        'Console.Out.Write(searchNode.sNodeNo)

        '获取当前最大节点Node
        If searchNode.isNull Then
            currentNode = findMaxDeepNode()
            searchNodesStackCurrent = 0
        Else
            currentNode = searchNode
        End If
        ReDim Preserve searchNodesStack(searchNodesStackCurrent)
        searchNodesStack(searchNodesStackCurrent) = currentNode

        searchNodesStack1.Push(currentNode)


        If searchNodesStackCurrent >= 1 Then
            '上一个节点
            preNode = searchNodesStack(searchNodesStackCurrent - 1)
        Else
            preNode = createNewNode()
        End If






        Dim lines() As TypeLine
        'Dim currentRate As Double = 0 '起点到当前点的正切角
        'currentRate = Math.Atan2(searchNodesStack(0).latitude - currentNode.latitude, searchNodesStack(0).longitude - currentNode.longitude)

        lines = findLines(currentNode, False)
        'For Each tmpline In lines
        '    If tmpline Is Nothing Then
        '        Continue For
        '    End If
        '    tmpline.SetRelaRate(0, tmpline.getRate)
        'Next



        'Array.Sort(lines, New MyCampare1)

        '对这些边进行优先排序,数据结构为（i，0） 线条的顺序，（i，1） 是否已经使用，收索优先顺序
        Dim lineSort(lines.GetLength(0) - 1, 2)
        Dim i As Integer = 0
        For i = 0 To lines.GetLength(0) - 1
            tmpline = lines(i)
            lineSort(i, 0) = tmpline
            lineSort(i, 1) = 0
            lineSort(i, 2) = tmpline.GetRelaRate
        Next


        For k = 0 To lineSort.GetLength(0) - 1
            Try
                Application.DoEvents()
                Threading.Thread.Sleep(0)
            Catch ex As Exception

            End Try


            lastRingEndNode = Nothing
            If lineSort(k, 1) = 1 And ClassConsManager.IS_SEARCHED_LINE_ON_BEGIN Then
                '该边已经搜索过，不在参与循环
                Continue For
            End If

            tmpline = lineSort(k, 0)


            lineSort(k, 1) = 1
            tmpline.SetSearched(True)

            If tmpline Is Nothing Then
                '如果存在不适合的数据，下一个数据
                Continue For
            End If


            '获取线路中的节点，如果
            If tmpline.startNode.sNodeNo = currentNode.sNodeNo Then
                nextNode = tmpline.endNode
            Else
                nextNode = tmpline.startNode
            End If

            If nextNode.sNodeNo = preNode.sNodeNo Then
                '是上一条线路的回线，继续下一条线路
                'Continue For
            Else
                '不是上一条线路的回线
                '不是回路，检查是否有环
                searchLineStack.Push(tmpline) '线路堆栈推入这一条线

                hasRing = False
                For i = searchNodesStackCurrent - 1 To 0 Step -1
                    If searchNodesStack(i).sNodeNo = nextNode.sNodeNo Then
                        '有环，建立环
                        hasRing = True
                        backToNodesStack = i
                        lastRingEndNode = currentNode
                        '退出循环
                        Exit For
                    End If
                Next
                If hasRing Then
                    '有环，建立环
                    buildRing(nextNode)
                    If ClassConsManager.IS_DEEP_SEARCH Then
                        Exit For
                    End If

                Else
                    '没有环，继续搜索下面的节点
                    searchNodesStackCurrent = searchNodesStackCurrent + 1
                    buildRings(nextNode, lastRingEndNode)
                End If
            End If




            If Not lastRingEndNode Is Nothing Then

                If backToNodesStack < searchNodesStackCurrent And ClassConsManager.IS_DEEP_SEARCH Then
                    '进行退栈，直到环上
                    Exit For
                End If


                '表示找到一个子环了，标记返回线为已搜索
                For kk = k + 1 To lineSort.GetLength(0) - 1
                    Dim tline As TypeLine = lineSort(kk, 0)
                    If tline.startNode.sNodeNo = lastRingEndNode.sNodeNo Or tline.endNode.sNodeNo = lastRingEndNode.sNodeNo Then
                        '返回线，
                        lineSort(kk, 1) = 1
                        tline.SetSearched(True)
                        Exit For
                    End If
                Next
            End If

            '如果节点队伍大于给定的最大搜索节点，不在该线上继续搜索下去
            If searchNodesStackCurrent > ClassConsManager.MAX_SEARCH_NODE_CNT Then
                Exit For
            End If

        Next
        '当前节点退栈
        searchNodesStackCurrent = searchNodesStackCurrent - 1
        searchNodesStack1.Pop()

        For i = 0 To lines.GetLength(0) - 1
            lineSort(i, 0) = Nothing
            lineSort(i, 1) = 0
            lineSort(i, 2) = 0
        Next


    End Sub

    Private Function createNewNode() As TypeNode
        '新建一个空的节点对象
        Dim tmpNode As TypeNode
        tmpNode = New TypeNode
        tmpNode.sNodeNo = ""
        tmpNode.SetNull(True)
        tmpNode.SetDelete(True)
        tmpNode.iUseCNT = 0
        createNewNode = tmpNode
    End Function

    Private Function createNewLine() As TypeLine
        '新建一个空的边对象
        Dim tmpLine As TypeLine
        tmpLine = New TypeLine
        tmpLine.sLineNo = ""
        tmpLine.setDelete(False)
        tmpLine.setNull(False)
        tmpLine.startNode = createNewNode()
        tmpLine.endNode = createNewNode()

        createNewLine = tmpLine
    End Function
    Private Function createNewRingLine(ByRef startNode As TypeNode, ByRef endNode As TypeNode) As TypeLine
        '新建一个空的边对象

        '保存数据
        Dim tmpline As TypeLine
        tmpline = New TypeLine(startNode, endNode, ClassConsManager.LineTypeEnum.RING_LINE)
        tmpline.sLineNo = Trim(Str(lineCounter))
        lineCounter = lineCounter + 1  '线路计算器


        If ringLines Is Nothing Then
            ReDim ringLines(0)
            ringLines(0) = tmpline
            createNewRingLine = tmpline
            Exit Function
        End If

        ReDim Preserve ringLines(ringLines.GetLength(0))
        ringLines(ringLines.GetLength(0) - 1) = tmpline
        createNewRingLine = tmpline

    End Function
    Private Sub buildCompLine()
        '构建复合边，如果一个点只有2个节点，则从这个点向外扩充，直到找到不是2个
        For Each tmpNode As TypeNode In node
            If tmpNode.getUseCNT = 2 Then
                '只有2个边，可以构建复合节点
                Dim lines As Integer = 0
                Dim tmpLine1, tmpLine2 As TypeLine
                tmpLine1 = Nothing
                tmpLine2 = Nothing
                For Each tmpLine As TypeLine In line
                    If tmpLine.isDelete Then
                        '已经标记为删除的线，不能在进行整合
                    Else
                        If tmpLine.startNode.sNodeNo = tmpNode.sNodeNo Then
                            '如果该边的另一个节点不是单一节点，即有多余两条的边，不能组合
                            If tmpLine.endNode.getUseCNT = 2 Then
                                If lines = 0 Then
                                    tmpLine1 = tmpLine
                                    lines = lines + 1
                                Else
                                    '2条边已经找到
                                    tmpLine2 = tmpLine
                                    Exit For
                                End If
                            Else
                                '不是单边组合，改点不能被省略
                                Exit For
                            End If
                        ElseIf tmpLine.endNode.sNodeNo = tmpNode.sNodeNo Then
                            If tmpLine.startNode.getUseCNT = 2 Then
                                If lines = 0 Then
                                    tmpLine1 = tmpLine
                                    lines = lines + 1
                                Else
                                    '2条边已经找到
                                    tmpLine2 = tmpLine
                                    Exit For
                                End If
                            Else
                                '不是单边组合，改点不能被省略
                                Exit For
                            End If
                        End If
                    End If

                Next
                If Not (tmpLine1 Is Nothing) And Not (tmpLine2 Is Nothing) Then
                    '判断是否是可以做成环，如果可以，则形成环，否则组成边
                    Dim isRingAble = False

                    If (tmpLine1.startNode.sNodeNo = tmpLine2.startNode.sNodeNo And tmpLine1.endNode.sNodeNo = tmpLine2.endNode.sNodeNo) _
                        Or (tmpLine1.endNode.sNodeNo = tmpLine2.startNode.sNodeNo And tmpLine1.startNode.sNodeNo = tmpLine2.endNode.sNodeNo) Then
                        '两条线的起点和对应一致，可以组成环
                        isRingAble = True
                    End If


                    If isRingAble = True Then
                        '可以组成环
                    Else
                        '建立新的复合边
                        Dim newLine As TypeLine
                        newLine = tmpLine1.combinLine(tmpLine1, tmpLine2)
                        newLine.setCombinLine(ClassConsManager.LineTypeEnum.COMBIN_LINE)
                        tmpLine1.setDelete(True)
                        tmpLine2.setDelete(True)
                        Dim kk As Integer = line.GetLength(0)
                        newLine.sLineNo = Trim(Str(lineCounter))
                        lineCounter = lineCounter + 1  '线路计算器
                        ReDim Preserve line(kk)
                        line(kk) = newLine
                        '该节点已经不用了    
                        tmpNode.SetDelete(True)
                    End If
                End If
            End If
        Next
    End Sub
    Private Sub buildSelfRing()
        '如果有2条边，构建自有环
        Dim i, k As Integer
        For i = 0 To line.GetLength(0) - 2
            Dim tmpLine As TypeLine = line(i)
            '对线路进行循环
            If tmpLine.startNode.sNodeNo = tmpLine.endNode.sNodeNo Then
                '起点和终点是同一个点，封闭的线环
                If tmpLine.isCombinLine = False Then
                    '不是复合环，不允许头尾都是同一个节点
                    Continue For
                End If
                '是复合环，将复合环中的内节点，转换成Rings，加入Rings中
                Dim nodeList() As TypeNode
                Dim nodeCnt As Integer = 0
                nodeCnt = tmpLine.getInnerNodes().GetLength(0) + 1
                ReDim nodeList(nodeCnt)
                nodeList(0) = tmpLine.startNode
                Dim n As Integer = 0
                For Each tmpNode As TypeNode In tmpLine.getInnerNodes
                    nodeList(n + 1) = tmpNode
                    n = n + 1
                Next
                '开始节点和结束节点一致，不添加该点
                'nodeList(n) = tmpLine.endNode
                '构建环，添加环
                Dim tmpRing As IClassTypeRing = New IClassTypeRing(nodeList)
                insertRing(tmpRing)
                '构建自有环后，需要将该线，标为删除标记，不参与后续的建环运算
                tmpLine.setDelete(True)


            End If

            For k = i + 1 To line.GetLength(0) - 1
                Dim tmpLine2 As TypeLine = line(k)
                If (tmpLine.startNode.sNodeNo = tmpLine2.startNode.sNodeNo And tmpLine.endNode.sNodeNo = tmpLine2.endNode.sNodeNo) _
                    Or (tmpLine.endNode.sNodeNo = tmpLine2.startNode.sNodeNo And tmpLine.startNode.sNodeNo = tmpLine2.endNode.sNodeNo) _
                    And tmpLine.sLineNo <> tmpLine2.sLineNo Then
                    '组建一个新环,并插入环表
                    Dim tmpRing As IClassTypeRing = New IClassTypeRing(tmpLine, tmpLine2)
                    insertRing(tmpRing)
                    '构建自有环后，需要将该线，标为删除标记，不参与后续的建环运算,在构建一条环边
                    tmpLine.setDelete(True)
                    tmpLine2.setDelete(True)
                    '构建一条环边,将该边插入边表中
                    Dim ttline As TypeLine = findRingLine(tmpLine.startNode, tmpLine.endNode)
                    If ttline Is Nothing Then
                        '在环边表中，没有这两个点间数据，则需要新建一个
                        '判断是不是新建边，如果是，加入边表，否则不加入边表
                        ttline = createNewRingLine(tmpLine.startNode, tmpLine.endNode)
                        ttline.addInnerLines(tmpLine)
                        ttline.addInnerLines(tmpLine2)
                        ReDim Preserve line(line.GetLength(0))
                        line(line.GetLength(0) - 1) = ttline
                    End If


                End If
            Next
            '   Threading.Thread.Sleep(50)
        Next
        Do
            If RingThreadCnt.RingThreadCnt > 0 Then
                Threading.Thread.Sleep(1000)
            Else
                Exit Do
            End If


        Loop

    End Sub

    Public tmpRingsCount As Integer = 0


    Public Sub insertRingList(ByRef tmpRing As IClassTypeRing)


        If ClassConsManager.SEARCH_THREAD_ABLE = True Then
            '使用线程方式插入环
            Dim thread As RingInsertThread = New RingInsertThread
            thread.tmpRing = tmpRing
            Threading.ThreadPool.QueueUserWorkItem(New Threading.WaitCallback(AddressOf thread.insertRingThread))
        Else
            '不使用线程方式插入环

            '判断是不是重复环，是丢弃，否保存
            For Each tmpR As IClassTypeRing In ringArray
                If tmpR.isSamRing(tmpR, tmpRing) Then
                    '是相同环，丢弃
                    loger.log("重复环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                    Exit Sub
                End If
            Next


            '
            Dim removerings As ArrayList = New ArrayList
            '判断是不是最小环，是丢弃，否保存
            Dim k As Integer = 0
            For Each tmpR As IClassTypeRing In ringArray
                Dim contain = tmpR.isContain(tmpR, tmpRing)
                If contain <> 0 Then
                    If contain < 0 Then
                        '非最小环，丢弃
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        Exit Sub
                    Else
                        '这里需要记录所有的非最小环
                        removerings.Add(tmpR)
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        'tmpRing.SetRingNo(tmpR.GetRingNo)
                        'rings(k) = tmpRing
                        'Exit Sub
                    End If
                End If
                k = k + 1
            Next


            For Each tmpR As IClassTypeRing In removerings
                ringArray.Remove(tmpR)
            Next







        End If

    End Sub



    Public Sub insertRing(ByRef tmpRing As IClassTypeRing)

        If rings Is Nothing Then
            ReDim rings(0)
        End If

        ringArray = New List(Of IClassTypeRing)
        For Each tmpR As IClassTypeRing In rings
            If Not tmpR Is Nothing Then
                ringArray.Add(tmpR)
            End If
        Next


        tmpRingsCount += 1
        ' Debug.WriteLine("环个数: " & tmpRingsCount)




        If rings.GetLength(0) <= 1 And rings(0) Is Nothing Then
            '目前没有环,加入环表中，不进行重复环判断
            ReDim rings(0)
            tmpRing.SetRingNo("0")
            rings(0) = tmpRing
            Exit Sub
        End If
        If ClassConsManager.SEARCH_THREAD_ABLE = True Then
            '使用线程方式插入环
            Dim thread As RingInsertThread = New RingInsertThread
            thread.tmpRing = tmpRing
            Threading.ThreadPool.QueueUserWorkItem(New Threading.WaitCallback(AddressOf thread.insertRingThread))
        Else
            '不使用线程方式插入环

            '判断是不是重复环，是丢弃，否保存
            For Each tmpR As IClassTypeRing In rings
                If tmpR.isSamRing(tmpR, tmpRing) Then
                    '是相同环，丢弃
                    loger.log("重复环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                    Exit Sub
                End If
            Next


            '
            Dim removerings As ArrayList = New ArrayList
            '判断是不是最小环，是丢弃，否保存
            Dim k As Integer = 0
            For Each tmpR As IClassTypeRing In rings
                Dim contain = tmpR.isContain(tmpR, tmpRing)
                If contain <> 0 Then
                    If contain < 0 Then
                        '非最小环，丢弃
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        clearRomoveRing(removerings)
                        Exit Sub
                    Else
                        '这里需要记录所有的非最小环
                        removerings.Add(tmpR)
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        'tmpRing.SetRingNo(tmpR.GetRingNo)
                        'rings(k) = tmpRing
                        'Exit Sub
                    End If
                End If
                k = k + 1
            Next

            '清理比当期环还大的最小环
            clearRomoveRing(removerings)

            '将环插入环表中
            Dim ringCnt = rings.GetLength(0)
            ReDim Preserve rings(ringCnt)
            tmpRing.SetRingNo(Trim(Str(ringCnt)))
            rings(ringCnt) = tmpRing
        End If

    End Sub
    ''' <summary>
    ''' 清除已经标记为不是最小环的环
    ''' </summary>
    ''' <param name="removerings"></param>
    ''' <remarks></remarks>
    Private Sub clearRomoveRing(ByVal removerings As ArrayList)

        ringArray = New List(Of IClassTypeRing)
        For Each tmpR As IClassTypeRing In rings
            If removerings.Contains(tmpR) Then
                '需要被最小环替换的环
            Else
                ringArray.Add(tmpR)
            End If
        Next

        ReDim rings(ringArray.Count - 1)

        Dim i = 0
        For Each tmpR As IClassTypeRing In ringArray
            rings(i) = tmpR
            i = i + 1
        Next

    End Sub


    Private Function findRingLine(ByRef startNode As TypeNode, ByRef endNode As TypeNode) As TypeLine
        If ringLines Is Nothing Then
            findRingLine = Nothing
            Exit Function
        End If


        For Each tmpLinde As TypeLine In ringLines

            If tmpLinde Is Nothing Then
                Continue For
            End If

            If tmpLinde.startNode.sNodeNo = startNode.sNodeNo Then
                If tmpLinde.endNode.sNodeNo = endNode.sNodeNo Then
                    '已经存在这样的环边
                    findRingLine = tmpLinde
                    Exit Function
                End If
            End If

            If tmpLinde.endNode.sNodeNo = startNode.sNodeNo Then
                If tmpLinde.startNode.sNodeNo = endNode.sNodeNo Then
                    '已经存在这样的环边
                    findRingLine = tmpLinde
                    Exit Function
                End If
            End If


        Next

        findRingLine = Nothing
    End Function


    Class RingInsertThread
        Public tmpRing As IClassTypeRing
        Public rings As IClassTypeRing()

        Private loger As IClassLog = New IClassLog

        Public Sub New(ByRef tmpring As IClassTypeRing, ByRef rings As IClassTypeRing())
            Me.tmpRing = tmpring
            Me.rings = rings

        End Sub



        Public Sub insertRingThread()

            SyncLock RingThreadCnt
                RingThreadCnt.RingThreadCnt += 1
            End SyncLock

            'Debug.Print("开始插入环" & tmpRing.getRingString)
            '    Debug.Print("现有环" & rings.GetLength(0))

            ''判断是不是重复环，是丢弃，否保存
            For Each tmpR As IClassTypeRing In rings
                If tmpR Is Nothing Then
                    Continue For
                End If
                If tmpR.isSamRing(tmpR, tmpRing) Then
                    '是相同环，丢弃
                    loger.log("重复环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                    SyncLock RingThreadCnt
                        RingThreadCnt.RingThreadCnt -= 1
                    End SyncLock
                    Exit Sub
                End If
            Next

            '判断是不是最小环，是丢弃，否保存
            Dim k = 0
            For Each tmpR As IClassTypeRing In rings
                If tmpR Is Nothing Then
                    Continue For
                End If
                Dim contain = tmpR.isContain(tmpR, tmpRing)
                If contain <> 0 Then
                    If contain < 0 Then
                        '非最小环，丢弃
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        SyncLock RingThreadCnt
                            RingThreadCnt.RingThreadCnt -= 1
                        End SyncLock
                        Exit Sub
                    Else
                        loger.log("非最小环，丢弃：" & tmpR.getRingString & "," & tmpRing.getRingString, ClassConsManager.LOG_LEVEL_INFO)
                        tmpRing.SetRingNo(tmpR.GetRingNo)
                        rings(k) = tmpRing
                        SyncLock RingThreadCnt
                            RingThreadCnt.RingThreadCnt -= 1
                        End SyncLock
                        Exit Sub
                    End If
                End If
                k = k + 1
            Next

            '将环插入环表中


            'Debug.Print("结束环" & rings.GetLength(0))

            SyncLock RingThreadCnt
                Dim ringCnt = rings.GetLength(0)
                ReDim Preserve rings(ringCnt)
                tmpRing.SetRingNo(Trim(Str(ringCnt)))
                rings(ringCnt) = tmpRing
                RingThreadCnt.RingThreadCnt -= 1
            End SyncLock

        End Sub

        Public Sub New()
            If ClassConsManager.SEARCH_THREAD_ABLE = True Then
                Threading.ThreadPool.SetMaxThreads(ClassConsManager.MAX_SEARCH_THREAD_CNT, 10)
            End If

        End Sub
    End Class

    Public Class MyCampare1
        Implements IComparer


        Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
            If TypeOf x Is TypeLine Then
                Dim line1 As TypeLine = x
                Dim line2 As TypeLine = y
                Dim result = 0
                Try
                    If Math.Abs(line1.GetRelaRate) > Math.Abs(line2.GetRelaRate) Then
                        result = 1
                    ElseIf Math.Abs(line2.GetRelaRate) > Math.Abs(line1.GetRelaRate) Then
                        result = -1
                    Else
                        result = 0
                    End If
                Catch

                End Try
                Return result
            ElseIf TypeOf x Is TypeNode Then
                Dim node1 As TypeNode = x
                Dim node2 As TypeNode = y
                Dim distance1, distance2 As Double
                ' distance1 = Math.Sqrt(node1.latitude ^ 2 + node1.longitude ^ 2)
                'distance2 = Math.Sqrt(node2.latitude ^ 2 + node2.longitude ^ 2)
                '比较节点边的个数
                distance1 = node1.getUseCNT
                distance2 = node2.getUseCNT

                If distance1 > distance2 Then
                    Return 1
                ElseIf distance2 > distance1 Then
                    Return -1
                Else
                    Return 0
                End If
            End If

        End Function
    End Class

End Class
